(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
                     T)
         (LISPXPRIN1 (QUOTE "25-MAR-73 06:20:16")
                     T)
         (LISPXTERPRI T))
  (LISPXPRINT (QUOTE ANALPATVARS)
              T)
  (RPAQQ ANALPATVARS
         ((FNS MAKEDEFAULT ANALPATELT ANALPAT MAXANAL MAX ANAL!PAT 
               TSTANAL $? SKIP$ SKIP$ANY SKIP$I ELT? MEMBPAT? ARB? 
               NOMATCHARB?)
          (VARS)))
(DEFINEQ

(MAKEDEFAULT
  [LAMBDA (PATELT)
    (COND
      [(EQ (CAR PATELT)
           (QUOTE DEFAULT))
        (SELECTQ VARDEFAULT
                 ((←
                     SETQ SET)
                   (FRPLACA (FRPLACD PATELT (CONS (CDR PATELT)
                                                  (QUOTE $1)))
                            (QUOTE ←)))
                 ((QUOTE ')
                   (FRPLACA PATELT (QUOTE ')))
                 ((= EQUAL)
                   (FRPLACA PATELT (QUOTE =)))
                 (HELP (QUOTE "FUNNY VARDEFAULT"]
      (T (SELECTQ VARDEFAULT
                  [(←
                      SETQ SET)
                    (CONS (QUOTE ←)
                          (CONS PATELT (QUOTE $1]
                  ((QUOTE ')
                    (CONS (QUOTE ')
                          PATELT))
                  ((= EQUAL)
                    (CONS (QUOTE =)
                          PATELT))
                  (HELP (QUOTE "FUNNY VARDEFAULT"])

(ANALPATELT
  [LAMBDA (PATELT SEGEXPR)

          (* Analyze PATELT , returning either -
          "ELT" if PATELT matches a single element -
          "SEG" if PATELT matches a segment of fixed but not 
          given size -
          A number if PATELT matches a segment of fixed, given 
          size -
          Or "ARB" if PATELT matches a segment of not 
          precomputable size)



          (* Unless SEGEXPR is on, in which case, the size of 
          the expr is returned instead of seg)



          (* Also, if the PATELT is a "SET", sets special 
          variable "SETS" -
          If it contains a match (i.e., other than $i's or $'s 
          or sets involving those) it sets the special 
          variable "MATCH")


    (COND
      ((NLISTP PATELT)
        (SELECTQ PATELT
                 [($1 &)
                   (COND
                     (SEGEXPR 1)
                     (T (QUOTE ELT]
                 [("*" *)
                   (SETQ SETS T)
                   (COND
                     (SEGEXPR 1)
                     (T (QUOTE ELT]
                 (($ --)
                   (QUOTE ARB))
                 (HELP (QUOTE "FUNNY PAT IN ANALPATELT")
                       PATELT)))
      (T (SELECTQ (CAR PATELT)
                  (! (ANAL!PAT (CDR PATELT)
                               SEGEXPR))
                  ($$                           (* Either $$ NUMBER or 
                                                $$ EXPRESSION)
                      (OR (NUMBERP (CDR PATELT))
                          (AND SEGEXPR (CDR PATELT))
                          (QUOTE SEG)))
                  (DEFAULT (ANALPATELT (MAKEDEFAULT PATELT)
                                       SEGEXPR))
                  [(= == ' :)
                    (SETQ MATCH T)              (* = FOO matches an 
                                                element)
                    (COND
                      (SEGEXPR 1)
                      (T (QUOTE ELT]
                  [ANY                          (* It's the MAX of them 
                                                all)
                       (ANALPAT (CDR PATELT)
                                (AND SEGEXPR (QUOTE SEGEXPR]
                  (←                            (* It's a set, with the 
                                                same PROP as what's 
                                                being set)
                    (SETQ SETS T)
                    (ANALPATELT (CDDR PATELT)
                                SEGEXPR))
                  (->                           (* Ditto)
                      (SETQ SETS T)
                      (ANALPATELT (CDDR PATELT)
                                  SEGEXPR))
                  ((!←
                      !->)
                    (SETQ SETS T)
                    0)
                  (PROGN                        (* Got a PATELT which is
                                                a list of pats)
                         (ANALPAT PATELT)
                         (COND
                           (SEGEXPR 1)
                           (T (QUOTE ELT])

(ANALPAT
  [LAMBDA (PAT FLG FN TAIL)

          (* Calls either ANALPATELT or FN on the elements of 
          PAT (up to TAIL) and returns the MAXANAL of them -
          The value of FLG determinses whether MAXANAL returns 
          a sum or a maximum)


    (PROG (VAL)
      LP  (COND
            ((OR (EQ PAT TAIL)
                 (NOT PAT))
              (RETURN VAL)))
          (SETQ VAL (MAXANAL (APPLY* (OR FN (QUOTE ANALPATELT))
                                     (CAR PAT))
                             VAL FLG))
          (SETQ PAT (CDR PAT))
          (GO LP])

(MAXANAL
  [LAMBDA (VAL1 VAL2 FLG)
    (COND
      ((NOT VAL1)
        VAL2)
      ((NOT VAL2)
        VAL1)
      ((OR (EQ VAL2 (QUOTE ARB))
           (EQ VAL1 (QUOTE ARB)))
        (QUOTE ARB))
      ((OR (EQ VAL1 (QUOTE SEG))
           (EQ VAL2 (QUOTE SEG)))
        (QUOTE SEG))
      ((EQ FLG (QUOTE SEGEXPR))
        ('PLUS VAL1 VAL2))
      (FLG (IPLUS (OR (NUMBERP VAL1)
                      1)
                  (OR (NUMBERP VAL2)
                      1)))
      [(EQ VAL1 (QUOTE ELT))
        (COND
          ((OR (EQ VAL2 1)
               (EQ VAL2 (QUOTE ELT)))
            VAL2)
          (T (QUOTE SEG]
      [(EQ VAL2 (QUOTE ELT))
        (COND
          ((EQ VAL1 1)
            VAL1)
          (T (QUOTE SEG]
      (T (QUOTE SEG])

(MAX
  [LAMBDA (X Y)
    (COND
      ((IGREATERP X Y)
        X)
      (T Y])

(ANAL!PAT
  [LAMBDA (PAT SEGEXPR)
    (COND
      ((NLISTP PAT)
        (SELECTQ PAT
                 (("*" *)                       (* !* is like result←$)
                   (SETQ SETS T)
                   (QUOTE ARB))
                 (($1 &)                        (* !$1 is the same as $)
                   (QUOTE ARB))
                 (HELP (QUOTE "FUNNY NLISTP PAT AFTER ! IN")
                       PAT)))
      (T (SELECTQ (CAR PAT)
                  ('                            (* !'exp matches exactly
                                                length exp things)
                    (LENGTH (CDR PAT)))
                  [(= ==)                       (* = exp matches 
                                                precomputable NUMBER of 
                                                things)
                    (SETQ MATCH T)
                    (COND
                      [SEGEXPR (LIST (QUOTE LENGTH)
                                     (CDR (CAR PAT]
                      (T (QUOTE SEG]
                  (:(QUOTE ARB))
                  ((←
                      ->)
                    (SETQ SETS T)
                    (ANAL!PAT (CDR PAT)))
                  (DEFAULT                      (* MAKEDEFAULT actually 
                                                smashes it, so go ahead 
                                                & try it again)
                           (MAKEDEFAULT PAT)
                           (ANAL!PAT PAT SEGEXPR))
                  (ANY 

          (* ! (any ...) matches the MAX of ANAL!PAT of the 
          elts of the any)


                       (ANALPAT (CDR PAT)
                                (AND SEGEXPR (QUOTE SEGEXPR))
                                (FUNCTION ANAL!PAT)))
                  (PROGN 

          (* Otherwise, there is a ! 
          (PAT) so it's the MAX, except if there are all fixed 
          segs, add'em up)


                         (ANALPAT PAT (COND
                                    (SEGEXPR (QUOTE SEGEXPR))
                                    (T T))
                                  NIL NIL])

(TSTANAL
  [LAMBDA (PAT)
    (PROG (SETS MATCH VA)
          (LIST (ANALPAT PAT)
                SETS MATCH])

($?
  [LAMBDA (PATELT)
    (FMEMB PATELT (QUOTE ($ ≠ --])

(SKIP$
  [LAMBDA (PAT SETOK MATCHOK TAIL)

          (* SCANS PAT UNTIL ONE OF THE FOLLOWING CONDITIONS 
          OCCURS: -
          (1) TAIL IS HIT -
          (2) A PATTERN ELEMENT WHICH MATCHES AN ARBITRARY 
          LENGTH SEGMENT IS HIT -
          (3) SETOK IS NIL AND A PATTERN ELMENT INVOLVING A ← 
          IS HIT -
          (4) MATCHOK IS NIL AND A PATTERN ELMENT INVOLVING A 
          "MATCH" OF ANYKIND IS HIT -
          (5) THE END OF PAT IS REACHED)



          (* The free variables SETS and MATCH are set to T if 
          a set or MATCH (respectively) are found in any of 
          the pattern elements passed over)


    (PROG (OLDSET OLDMATCH)
      LP  (SETQ OLDSET SETS)
          (SETQ OLDMATCH MATCH)
          [COND
            ((OR (NULL PAT)
                 (EQ PAT TAIL))
              (RETURN PAT))
            ((OR (EQ (SETQ TEM (ANALPATELT (CAR PAT)
                                           T))
                     (QUOTE ARB))
                 (AND (NOT SETOK)
                      SETS)
                 (AND (NOT MATCHOK)
                      MATCH))
              (SETQ SETS OLDSET)
              (SETQ MATCH OLDMATCH)
              (RETURN PAT))
            (T (SETQ LEN ('PLUS TEM LEN]
          (SETQ PAT (CDR PAT))
          (GO LP])

(SKIP$ANY
  [LAMBDA (PAT)

          (* Scans PAT until a pattern element which matches 
          an arbitrary length segment is hit)



          (* The free variables SETS and MATCH are set to T if 
          a set or MATCH (respectively) are found in any of 
          the pattern elements passed over)


    (PROG (OLDSET OLDMATCH TEM)
      LP  (SETQ OLDSET SETS)
          (SETQ OLDMATCH MATCH)
          [COND
            ((NULL PAT)
              (RETURN PAT))
            ((EQ (SETQ TEM (ANALPATELT (CAR PAT)
                                       T))
                 (QUOTE ARB))
              (SETQ SETS OLDSET)
              (SETQ MATCH OLDMATCH)
              (RETURN PAT))
            (T (SETQ LEN ('PLUS TEM LEN]
          (SETQ PAT (CDR PAT))
          (GO LP])

(SKIP$I
  [LAMBDA (PAT)

          (* Returns (and sets the variable "TAIL") to the 
          first TAIL of PAT which doesn't begin with a $i or a 
          $$foo -
          Sets the variable "LEN" to the total length of 
          things skipped over)


    (SETQ TAIL (SOME PAT (FUNCTION (LAMBDA (ELT)
                         (COND
                           ((FMEMB ELT (QUOTE (& $1 ≠1)))
                             (SETQ LEN ('PLUS 1 LEN))
                             NIL)
                           ((EQ (CAR ELT)
                                (QUOTE $$))
                             (SETQ LEN ('PLUS LEN (CDR ELT)))
                             NIL)
                           (T])

(ELT?
  [LAMBDA (PATELT)
    (EQ (ANALPATELT PATELT)
        (QUOTE ELT])

(MEMBPAT?
  [LAMBDA (PAT)                                 (* Can a MEMB be used 
                                                for pat?)
    (AND (FMEMB (CAAR PAT)
                (QUOTE (' = ==)))
         (PROG (SETS MATCH TEM3 (PAT2 (CDR PAT)))

          (* Check if PAT ends is ($ 'foo nomatch nomatch ...
          Arb-nomatch ...))


           LP  (COND
                 ((NULL PAT2)
                   (RETURN))
                 ((AND (OR (EQ (SETQ TEM3 (ANALPATELT (CAR PAT2)))
                               (QUOTE ELT))
                           (NUMBERP TEM3))
                       (NULL MATCH))
                   (SETQ PAT2 (CDR PAT2)))
                 ((AND (NULL MATCH)
                       (EQ TEM3 (QUOTE ARB)))
                   (RETURN PAT2))
                 (T (RETURN)))
               (GO LP])

(ARB?
  [LAMBDA (PATELT)
    (EQ (ANALPATELT PATELT)
        (QUOTE ARB])

(NOMATCHARB?
  [LAMBDA (PATELT)
    (PROG (MATCH)
          (AND (EQ (ANALPATELT PATELT)
                   (QUOTE ARB))
               (NULL MATCH])
)
STOP